##Introducere #Reprezentarea datelor sub forma de retea e o abordare diferita fata de modul clasic de reprezentare, cel tabelar. Acest format poate evidentia noi caracteristici ale datelor si imbunatesteste vizualizarea acestora intr-un mod semnificativ. #Pentru a realiza o analiza originala, setul de date folosit reprezinta structura unei retele de trafic cu tigari de contrabanda din Romania, datele fiind extrase dintr-un dosar penal. Astfel, utilizand metode de graph mining vom realiza o analiza asupra structurii retelei, dar si asupra rolurilor individuale ale membrilor.

Capitolul 1 - Modelarea datelor in R

#Datele au fost modelate folosind un obiect de tip reţea din librăria statnet. Legăturile dintre noduri au fost introduse folosind o lista de muchii, iar nodurile au următoarele atribute : nume, nume abreviat si rol.

knitr::opts_chunk$set(echo = FALSE)
library(statnet)
## Loading required package: tergm
## Loading required package: ergm
## Loading required package: network
## network: Classes for Relational Data
## Version 1.16.1 created on 2020-10-06.
## copyright (c) 2005, Carter T. Butts, University of California-Irvine
##                     Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Martina Morris, University of Washington
##                     Skye Bender-deMoll, University of Washington
##  For citation information, type citation("network").
##  Type help("network-package") to get started.
## 
## ergm: version 3.11.0, created on 2020-10-14
## Copyright (c) 2020, Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Carter T. Butts, University of California -- Irvine
##                     Steven M. Goodreau, University of Washington
##                     Pavel N. Krivitsky, UNSW Sydney
##                     Martina Morris, University of Washington
##                     with contributions from
##                     Li Wang
##                     Kirk Li, University of Washington
##                     Skye Bender-deMoll, University of Washington
##                     Chad Klumb
##                     Michał Bojanowski, Kozminski University
##                     Ben Bolker
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("ergm").
## NOTE: Versions before 3.6.1 had a bug in the implementation of the bd()
## constraint which distorted the sampled distribution somewhat. In
## addition, Sampson's Monks datasets had mislabeled vertices. See the
## NEWS and the documentation for more details.
## NOTE: Some common term arguments pertaining to vertex attribute and
## level selection have changed in 3.10.0. See terms help for more
## details. Use 'options(ergm.term=list(version="3.9.4"))' to use old
## behavior.
## Loading required package: networkDynamic
## 
## networkDynamic: version 0.10.1, created on 2020-01-16
## Copyright (c) 2020, Carter T. Butts, University of California -- Irvine
##                     Ayn Leslie-Cook, University of Washington
##                     Pavel N. Krivitsky, University of Wollongong
##                     Skye Bender-deMoll, University of Washington
##                     with contributions from
##                     Zack Almquist, University of California -- Irvine
##                     David R. Hunter, Penn State University
##                     Li Wang
##                     Kirk Li, University of Washington
##                     Steven M. Goodreau, University of Washington
##                     Jeffrey Horner
##                     Martina Morris, University of Washington
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("networkDynamic").
## 
## tergm: version 3.7.0, created on 2020-10-15
## Copyright (c) 2020, Pavel N. Krivitsky, UNSW Sydney
##                     Mark S. Handcock, University of California -- Los Angeles
##                     with contributions from
##                     David R. Hunter, Penn State University
##                     Steven M. Goodreau, University of Washington
##                     Martina Morris, University of Washington
##                     Nicole Bohme Carnegie, New York University
##                     Carter T. Butts, University of California -- Irvine
##                     Ayn Leslie-Cook, University of Washington
##                     Skye Bender-deMoll
##                     Li Wang
##                     Kirk Li, University of Washington
##                     Chad Klumb
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("tergm").
## Loading required package: ergm.count
## 
## ergm.count: version 3.4.0, created on 2019-05-15
## Copyright (c) 2019, Pavel N. Krivitsky, University of Wollongong
##                     with contributions from
##                     Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("ergm.count").
## NOTE: The form of the term 'CMP' has been changed in version 3.2 of
## 'ergm.count'. See the news or help('CMP') for more information.
## Loading required package: sna
## Loading required package: statnet.common
## 
## Attaching package: 'statnet.common'
## The following object is masked from 'package:base':
## 
##     order
## sna: Tools for Social Network Analysis
## Version 2.6 created on 2020-10-5.
## copyright (c) 2005, Carter T. Butts, University of California-Irvine
##  For citation information, type citation("sna").
##  Type help(package="sna") to get started.
## Loading required package: tsna
## 
## statnet: version 2019.6, created on 2019-06-13
## Copyright (c) 2019, Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Carter T. Butts, University of California -- Irvine
##                     Steven M. Goodreau, University of Washington
##                     Pavel N. Krivitsky, University of Wollongong
##                     Skye Bender-deMoll
##                     Martina Morris, University of Washington
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("statnet").
library(RColorBrewer)
library(network)

#Pentru a ne asigura ca graful este unul ne-orientat, simetrizam matricea de adiacenta asociata primului obiect, si generam un nou obiect, pentru a lucra cu un graf ne-orientat. Acest lucru se datoreaza faptului ca relatiile sociale in cadrul acestei retele nu pot fi uni-directionale.

#Extragerea atributelor retelei in variabile separate, pentru a fi folosite ulterior in operatiile de plotare.

#Un prim plot al retelei pentru a vizualiza structura acesteia, si impartirea membrilor pe roluri.

Capitolul 2 - Analiza primara a retelei

#O prima analiza asupra retelei este realizarea rezumatului in 5 puncte. Functiile prezente in libraria statnet faciliteaza realizarea acesteia. Analizand aceste valori, putem avea o prima impresie despre structura retelei si despre modul de organizarea a acesteia.

print("BASIC CHARACTERISTICS")
## [1] "BASIC CHARACTERISTICS"
summary(netsym, print.adj = FALSE)
## Network attributes:
##   vertices = 21
##   directed = TRUE
##   hyper = FALSE
##   loops = FALSE
##   multiple = FALSE
##   bipartite = FALSE
##  total edges = 72 
##    missing edges = 0 
##    non-missing edges = 72 
##  density = 0.1714286 
## 
## Vertex attributes:
## 
##  abrev_name:
##    character valued attribute
##    attribute summary:
##    the 10 most common values are:
## BA BC BG BL CI DC DD DI DR GG 
##  1  1  1  1  1  1  1  1  1  1 
## 
##  alldeg:
##    numeric valued attribute
##    attribute summary:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.000   4.000   6.000   6.857  10.000  14.000 
## 
##  role:
##    character valued attribute
##    attribute summary:
##  A  C CR CT  D 
##  2 12  1  4  2 
##   vertex.names:
##    character valued attribute
##    21 valid vertex names
## 
## No edge attributes
print("Size:")
## [1] "Size:"
print(network.size(netsym))
## [1] 21
print("Density:")
## [1] "Density:"
print(gden(netsym))
## [1] 0.1714286
print("Components:")
## [1] "Components:"
print(components(netsym))
## [1] 1
print("Diameter:")
## [1] "Diameter:"
gd <- geodist(netsym)
print(max(gd$gdist))
## [1] 7
print("Transitivity:")
## [1] "Transitivity:"
print(gtrans(netsym, mode="graph"))
## [1] 0.25

3. Capitolul 3 - Managementul datelor atribuite unei retele

Folosind atributele definite în momentul creării, putem filtra reţeua astfel încat putem evidenţia importanţa unui anume rol. Spre exemplu, dacă am păstra în reţea doar Comercianţii, putem observa că aceştia sunt în mare partea izolaţi, distrugând aspectul de reţea compactă. Acest lucru evidenţiază rolul contrabandiştilor în reţea, aceştia asigurând practic conexitatea reţelei.

print("Filtering networks")
print(get.vertex.attribute(netsym, "role"))
comercianti <- get.inducedSubgraph(netsym, which (netsym %v% "role"=="C"))
gplot(comercianti,displaylabels=TRUE, main="Comercianti")

delete.vertices(comercianti, isolates(comercianti))
gplot(comercianti, displaylabels = TRUE, main="Grupuri de comercianti")

# 4.Basic network plotting and layout

# Circle
gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='circle',main="circle")

Eigen

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='eigen',main="eigen")

Random

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='random',main="random")

Spring

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='spring',main="spring")

Fruchterman-Reingold

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='fruchtermanreingold',main='fruchtermanreingold')

Kamada-Kawai

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='kamadakawai',
      main='kamadakawai')

5.Effective network graphic design

library(network)

library(intergraph)
library(igraph)
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:sna':
## 
##     betweenness, bonpow, closeness, components, degree, dyad.census,
##     evcent, hierarchy, is.connected, neighborhood, triad.census
## The following objects are masked from 'package:network':
## 
##     %c%, %s%, add.edges, add.vertices, delete.edges, delete.vertices,
##     get.edge.attribute, get.edges, get.vertex.attribute, is.bipartite,
##     is.directed, list.edge.attributes, list.vertex.attributes,
##     set.edge.attribute, set.vertex.attribute
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union
library(networkD3)
plot(netsym,vertex.cex=0.5,main="Too small nodes")

plot(netsym,vertex.cex=6,main="Too large nodes")

plot(netsym,vertex.cex=2,main="Just right node size")

Different node type

sidenum <- 3:7
rolecat <- as.factor(get.vertex.attribute(asIgraph(netsym),"role"))
plot(netsym,usearrows=FALSE,vertex.cex=4, main="Different node type",
     displaylabels=F,vertex.sides=sidenum[rolecat])

Edge coloring example

n_edge <- network.edgecount(netsym)
linecol_pal <- c("blue","red","green")
edge_cat <- sample(1:3,n_edge,replace=T)
plot(netsym,vertex.cex=1.5,vertex.col="grey25", main="Edge coloring example",
     edge.col=linecol_pal[edge_cat],edge.lwd=2)

Different edge width

widths <- c(2,6,10)
plot(netsym,vertex.cex=1.5,main="Different edge width",
     edge.lwd=1.5*widths)

Different edge type

n_edge <- network.edgecount(netsym)
edge_cat <- sample(1:3,n_edge,replace=T)
line_pal <- c(2,3,4)
gplot(netsym,vertex.cex=0.8,gmode="graph", main="Different edge type",
      vertex.col="gray50",edge.lwd=1.5,
      edge.lty=line_pal[edge_cat])

Infractional network

my_pal <- brewer.pal(5,"Dark2")
rolecat <- as.factor(get.vertex.attribute(asIgraph(netsym),"role"))
plot(netsym,
     main = "Infractional network",
     usearrows=FALSE, 
     mode="fruchtermanreingold", 
     vertex.col = my_pal[rolecat],
     label=abrevnamelab,
     displaylabels=T,
     vertex.cex = 1.5)
legend("bottomleft",legend=c("Aducator clienti","Comerciant","Cartita","Contrabandist","Depozitare"),
       col=my_pal,pch=19,pt.cex=1.5,bty="n",
       title="Criminal Role")

# necessary, caused conflicts
detach("package:statnet", unload=TRUE)

6.Advanced Network Graphics

Tkplot

inetsym <- asIgraph(netsym)
Coord <- tkplot(inetsym, vertex.size=3,
                vertex.label=V(inetsym)$role,
                vertex.color="darkgreen")
MCoords <- tkplot.getcoords(Coord)
plot(inetsym, layout=MCoords, vertex.size=5,main="Interactive tkplot",
     vertex.label=NA, vertex.color="lightblue")

# NetworkD3
inetsym_edge <- get.edgelist(inetsym)
inetsym_edge <- inetsym_edge - 1
inetsym_edge <- data.frame(inetsym_edge)
print(V(inetsym)$role)
##  [1] "C"  "C"  "C"  "CR" "C"  "C"  "CT" "CT" "CT" "C"  "C"  "A"  "A"  "C"  "C" 
## [16] "C"  "C"  "C"  "CT" "D"  "D"
inetsym_nodes <- data.frame(NodeID=as.numeric(V(inetsym)-1),
                          Group=V(inetsym)$role,
                          Nodesize=(degree(inetsym)))
net_D3 <- forceNetwork(Links = inetsym_edge, Nodes = inetsym_nodes,
             Source = "X1", Target = "X2",
             NodeID = "NodeID",Nodesize = "Nodesize",
             radiusCalculation="Math.sqrt(d.nodesize)*3",
             Group = "Group", opacity = 0.8,
             legend=TRUE)

saveNetwork(net_D3,file = 'Net_test2.html',
            selfcontained=TRUE)


#Visnetwork
library(visNetwork)
inetsym_edge <- get.edgelist(inetsym)
inetsym_edge <- data.frame(from = inetsym_edge[,1],
                         to = inetsym_edge[,2])
inetsym_nodes <- data.frame(id = as.numeric(V(inetsym)))
visNetwork(inetsym_nodes, inetsym_edge, width = "100%")
net <- visNetwork(inetsym_nodes, inetsym_edge,
                  width = "100%",legend=TRUE)
## Warning in visNetwork(inetsym_nodes, inetsym_edge, width = "100%", legend =
## TRUE): 'legend' and 'legend.width' are deprecated (visNetwork >= 0.1.2). Please
## now prefer use visLegend function.
net <- visOptions(net,highlightNearest = TRUE)
net <- visInteraction(net,navigationButtons = TRUE)
library(htmlwidgets)
## 
## Attaching package: 'htmlwidgets'
## The following object is masked from 'package:networkD3':
## 
##     JS
saveWidget(net, "Net_test3.html")

Chord diagram

library(circlize)
## ========================================
## circlize version 0.4.11
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
## 
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
##   in R. Bioinformatics 2014.
## 
## This message can be suppressed by:
##   suppressPackageStartupMessages(library(circlize))
## ========================================
## 
## Attaching package: 'circlize'
## The following object is masked from 'package:igraph':
## 
##     degree
## The following object is masked from 'package:sna':
## 
##     degree
library(statnet)
## 
## statnet: version 2019.6, created on 2019-06-13
## Copyright (c) 2019, Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Carter T. Butts, University of California -- Irvine
##                     Steven M. Goodreau, University of Washington
##                     Pavel N. Krivitsky, University of Wollongong
##                     Skye Bender-deMoll
##                     Martina Morris, University of Washington
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("statnet").
sociomat <- as.sociomatrix(netsym,attrname='passes')
## Warning in as.matrix.network.adjacency(x, attrname = attrname, expand.bipartite
## = expand.bipartite, : There is no edge attribute named passes
chordDiagram(sociomat)

detach("package:statnet", unload=TRUE)
detach("package:circlize", unload=TRUE)

7. Actor proeminence

detach("package:networkD3", unload=TRUE)
detach("package:igraph", unload=TRUE)
print("CENTRALITY DEGREES")
## [1] "CENTRALITY DEGREES"
print(degree(netsym, gmode="graph"))
##  [1] 6 2 4 1 5 5 3 7 6 2 2 5 3 3 2 2 2 2 6 2 2
print(closeness(netsym, gmode="graph"))
##  [1] 0.4761905 0.3333333 0.3846154 0.3278689 0.3278689 0.3278689 0.3174603
##  [8] 0.4166667 0.4081633 0.2531646 0.2941176 0.2564103 0.3636364 0.4444444
## [15] 0.2941176 0.2941176 0.2941176 0.2941176 0.3846154 0.3076923 0.3076923
print(betweenness(netsym, gmode="graph"))
##  [1] 113.1666667   0.0000000   4.1666667   0.0000000   9.6666667   9.6666667
##  [7]   0.0000000  51.0000000  36.0000000   0.0000000   3.6000000   7.0000000
## [13]  16.6000000  96.0000000   2.8500000   2.8500000   2.8500000   2.8500000
## [19]  69.4000000   0.1666667   0.1666667
#Cutpoints
cpnet <- cutpoints(netsym,mode="graph",
                   return.indicator=TRUE)
gplot(netsym,gmode="graph",vertex.col=cpnet+2,coord=MCoords,
      jitter=FALSE,displaylabels=TRUE)

#Bridges
bridges <- function(dat,mode="graph",
                    connected=c("strong", "weak")) {
   e_cnt <- network.edgecount(dat)
   if (mode == "graph") {
      cmp_cnt <- components(dat)
      b_vec <- rep(FALSE,e_cnt)
      for(i in 1:e_cnt){
         dat2 <- dat
         delete.edges(dat2,i)
         b_vec[i] <- (components(dat2) != cmp_cnt)
      }
   }
   else {
      cmp_cnt <- components(dat,connected=connected)
      b_vec <- rep(FALSE,e_cnt)
      for(i in 1:e_cnt){
         dat2 <- dat
         delete.edges(dat2,i)
         b_vec[i] <- (components(dat2) != cmp_cnt)
      }
   }
   return(b_vec)
}
bridges(netsym)
##  [1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## [13]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [49] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
colors <- c("blue", "red")

# Determining the centre nodes using the degree
deg <- degree(netsym, gmode="graph")
plot(netsym,
     usearrows=FALSE, 
     vertex.col = colors[(deg >= 5) + 1],
     label = netsym %v% "abrev_name",
     displaylabels=T,
     vertex.cex = deg/2)

# Determining the centre nodes using the closeness function
cls <- closeness(netsym, gmode="graph")
plot(netsym,
     usearrows=FALSE, 
     vertex.col = colors[(cls >= 0.33) + 1],
     label = netsym %v% "abrev_name",
     displaylabels=T,
     vertex.cex = cls*10)

# Determining the centre nodes using the betweenness function
bet <- betweenness(netsym, gmode="graph")
plot(netsym,
     usearrows=FALSE, 
     vertex.col = colors[(bet >= 90) + 1],
     label = netsym %v% "abrev_name",
     displaylabels=T,
     vertex.cex = sqrt(bet+1))

# Computing the level of correlation between multiple centrality measures
df.prom <- data.frame(
        deg = degree(netsym),
        cls = closeness(netsym),
        btw =  betweenness(netsym),
        evc = evcent(netsym),
        inf = infocent(netsym),
        flb = flowbet(netsym)
)
cor(df.prom)
##           deg       cls       btw       evc       inf       flb
## deg 1.0000000 0.6013689 0.5917256 0.6360877 0.7918289 0.5708101
## cls 0.6013689 1.0000000 0.8545112 0.4791390 0.8593100 0.8230555
## btw 0.5917256 0.8545112 1.0000000 0.2297788 0.7352932 0.9357088
## evc 0.6360877 0.4791390 0.2297788 1.0000000 0.7469055 0.3381616
## inf 0.7918289 0.8593100 0.7352932 0.7469055 1.0000000 0.7994418
## flb 0.5708101 0.8230555 0.9357088 0.3381616 0.7994418 1.0000000
# Tabular visualization for multiple centrality measures
# Defining a data frame in which is computed the centrality for all nodes using
# multiple methods
df.prom2 <- data.frame(
        name = network.vertex.names(netsym),
        degree = degree(netsym, gmode="graph"),
        closeness = closeness(netsym, gmode="graph"),
        betweenness = betweenness(netsym, gmode="graph"))
df.promsort <- df.prom2[order(-df.prom2$degree),]
cd <- centralization(netsym,degree)
cc <- centralization(netsym,closeness)
cb <- centralization(netsym,betweenness)
df.promsort <- rbind(df.promsort,data.frame(
        name = "Centralization level",
        degree = cd,
        closeness = cc,
        betweenness = cb
))
df.promsort
##                     name    degree closeness betweenness
## 8           T**a G***ghe 7.0000000 0.4166667  51.0000000
## 1          B***cu L***na 6.0000000 0.4761905 113.1666667
## 9            S**m An**la 6.0000000 0.4081633  36.0000000
## 19            D**a I***l 6.0000000 0.3846154  69.4000000
## 5            M**tu M**na 5.0000000 0.3278689   9.6666667
## 6           Ma**u I***he 5.0000000 0.3278689   9.6666667
## 12           M***u L**do 5.0000000 0.2564103   7.0000000
## 3         B**scu C***nel 4.0000000 0.3846154   4.1666667
## 7              T**a F**p 3.0000000 0.3174603   0.0000000
## 13             D**a D**a 3.0000000 0.3636364  16.6000000
## 14             D**a C**l 3.0000000 0.4444444  96.0000000
## 2         B***cu An***us 2.0000000 0.3333333   0.0000000
## 10        G**ca G****ghe 2.0000000 0.2531646   0.0000000
## 11             C**u I**n 2.0000000 0.2941176   3.6000000
## 15            N**cu P**u 2.0000000 0.2941176   2.8500000
## 16           N**se T**er 2.0000000 0.2941176   2.8500000
## 17        S***an C***tin 2.0000000 0.2941176   2.8500000
## 18           O***u A**ei 2.0000000 0.2941176   2.8500000
## 20           P**ci V***e 2.0000000 0.3076923   0.1666667
## 21          D***mir R**a 2.0000000 0.3076923   0.1666667
## 4          B**hiu G***ge 1.0000000 0.3278689   0.0000000
## 110 Centralization level 0.1973684 0.1518153   0.5127632
# Cutpoints are nodes that if removed will affect the conectivity of the network
# In the graphic below, it is displayed with green the cutpoint nodes.
cpnet <- cutpoints(netsym,mode="graph",return.indicator=TRUE)
gplot(netsym,gmode="graph",vertex.cex=cpnet+2,vertex.col=cpnet+2,jitter=FALSE,
      displaylabels=TRUE,label=netsym %v% "abrev_name")

# Bridges are edges that if removed will affect the conectivity of the network
# In the graphic below it is displayed with green the edges that are bridges.
bridges <- function(dat,mode="graph",connected=c("strong", "weak")) {
        e_cnt <- network.edgecount(dat)
        if (mode == "graph") {
                cmp_cnt <- components(dat)
                b_vec <- rep(FALSE,e_cnt)
                for(i in 1:e_cnt){
                        dat2 <- dat
                        delete.edges(dat2,i)
                        b_vec[i] <- (components(dat2) != cmp_cnt)
                }
        }
        else {
                cmp_cnt <- components(dat,connected=connected)
                b_vec <- rep(FALSE,e_cnt)
                for(i in 1:e_cnt){
                        dat2 <- dat
                        delete.edges(dat2,i)
                        b_vec[i] <- (components(dat2,connected=connected) != cmp_cnt)
                }
        }
        return (b_vec)
}
bridges(netsym)
##  [1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## [13]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [49] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
brnet <- bridges(netsym)
gplot(netsym,gmode="graph",vertex.col="red",edge.col=brnet+2,jitter=FALSE,
      displaylabels=TRUE,label=netsym %v% "abrev_name",edge.lwd=3*brnet+2)

Chapter 8

## Setup
### Import igraph for this part of the project
library(igraph)
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:sna':
## 
##     betweenness, bonpow, closeness, components, degree, dyad.census,
##     evcent, hierarchy, is.connected, neighborhood, triad.census
## The following objects are masked from 'package:network':
## 
##     %c%, %s%, add.edges, add.vertices, delete.edges, delete.vertices,
##     get.edge.attribute, get.edges, get.vertex.attribute, is.bipartite,
##     is.directed, list.edge.attributes, list.vertex.attributes,
##     set.edge.attribute, set.vertex.attribute
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union
library(intergraph)
### Transfer network from statnet format to igraph format
inetsym <- as.undirected(asIgraph(netsym))
V(inetsym)$name <- netsym %v% "abrev_name"
V(inetsym)$fullname <- network.vertex.names(netsym)
V(inetsym)$role <- rolecat

## Cliques
### Determine the cliques from the network as well as the biggest clique.
clique.number(inetsym)
## [1] 4
cliques(inetsym, min=3)
## [[1]]
## + 3/21 vertices, named, from 69f711f:
## [1] MI TF TG
## 
## [[2]]
## + 3/21 vertices, named, from 69f711f:
## [1] DD DC DI
## 
## [[3]]
## + 3/21 vertices, named, from 69f711f:
## [1] BL BA BC
## 
## [[4]]
## + 3/21 vertices, named, from 69f711f:
## [1] BL BC SA
## 
## [[5]]
## + 3/21 vertices, named, from 69f711f:
## [1] BL BC TG
## 
## [[6]]
## + 3/21 vertices, named, from 69f711f:
## [1] MM MI TF
## 
## [[7]]
## + 4/21 vertices, named, from 69f711f:
## [1] MM MI TF TG
## 
## [[8]]
## + 3/21 vertices, named, from 69f711f:
## [1] MM MI GG
## 
## [[9]]
## + 3/21 vertices, named, from 69f711f:
## [1] MM MI SA
## 
## [[10]]
## + 3/21 vertices, named, from 69f711f:
## [1] MM MI TG
## 
## [[11]]
## + 3/21 vertices, named, from 69f711f:
## [1] MM TF TG
maximal.cliques(inetsym, min=3)
## [[1]]
## + 3/21 vertices, named, from 69f711f:
## [1] BA BL BC
## 
## [[2]]
## + 3/21 vertices, named, from 69f711f:
## [1] DC DD DI
## 
## [[3]]
## + 3/21 vertices, named, from 69f711f:
## [1] GG MM MI
## 
## [[4]]
## + 4/21 vertices, named, from 69f711f:
## [1] TF MM TG MI
## 
## [[5]]
## + 3/21 vertices, named, from 69f711f:
## [1] MM MI SA
## 
## [[6]]
## + 3/21 vertices, named, from 69f711f:
## [1] BC BL TG
## 
## [[7]]
## + 3/21 vertices, named, from 69f711f:
## [1] BC BL SA
largest.cliques(inetsym)
## [[1]]
## + 4/21 vertices, named, from 69f711f:
## [1] TG MM MI TF
## k-Cores
coreness <- graph.coreness(inetsym)
table(coreness)
## coreness
##  1  2  3 
##  1 13  7
maxCoreness <- max(coreness)
maxCoreness
## [1] 3
colors <- rainbow(maxCoreness)
plot(inetsym,vertex.label=coreness,vertex.color=colors[coreness],layout=layout_with_fr)

i1_3 <- inetsym
i2_3 <- induced.subgraph(inetsym, vids=which(coreness > 1))
i3_3 <- induced.subgraph(inetsym, vids=which(coreness > 2))
lay <- layout.fruchterman.reingold(inetsym)
op <- par(mfrow=c(1,3),mar = c(3,0,2,0))
plot(i1_3,layout=lay,vertex.label=coreness,vertex.color=colors[coreness],main="All k-cores")
plot(i2_3,layout=lay[which(coreness > 1),],vertex.label=coreness[which(coreness > 1)],vertex.color=colors[coreness[which(coreness > 1)]],main="k-cores 2-3")
plot(i3_3,layout=lay[which(coreness > 2),],vertex.label=coreness[which(coreness > 2)],vertex.color=colors[coreness[which(coreness > 2)]],main="k-cores 3")

par(op)

## Modularity is a measure that describes how good is a network clusterization
colors <- brewer.pal(5,"Dark2")
roles <- c("C","CR","CT","A","D")
V(inetsym)[V(inetsym)$role == "C"]$color <- colors[1]
V(inetsym)[V(inetsym)$role == "CR"]$color <- colors[2]
V(inetsym)[V(inetsym)$role == "CT"]$color <- colors[3]
V(inetsym)[V(inetsym)$role == "A"]$color <- colors[4]
V(inetsym)[V(inetsym)$role == "D"]$color <- colors[5]

V(inetsym)[V(inetsym)$role == "C"]$group <- 1
V(inetsym)[V(inetsym)$role == "CR"]$group <- 2
V(inetsym)[V(inetsym)$role == "CT"]$group <- 3
V(inetsym)[V(inetsym)$role == "A"]$group <- 4
V(inetsym)[V(inetsym)$role == "D"]$group <- 5

op <- par(mfrow=c(1,1))
plot(inetsym,vertex.color=V(inetsym)$color,vertex.size=10)

## Modularity based on the role of each person
modularity(inetsym, V(inetsym)$group)
## [1] 0
## The result is smaller than 0, which means a bad clusterization result using this method

## Community detection algorithms
cw <- cluster_walktrap(inetsym)
modularity(cw)
## [1] 0.4903549
membership(cw)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  3  3  3  3  2  2  2  2  2  2  1  1  1  1  1  1  1  1  1  2  2
ceb <- cluster_edge_betweenness(inetsym)
modularity(ceb)
## [1] 0.4903549
membership(ceb)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  1  1  1  1  2  2  2  2  2  2  3  3  3  3  3  3  3  3  3  2  2
cs <- cluster_spinglass(inetsym)
modularity(cs)
## [1] 0.4903549
membership(cs)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  3  3  3  3  1  1  1  1  1  1  2  2  2  2  2  2  2  2  2  1  1
cfg <- cluster_fast_greedy(inetsym)
modularity(cfg)
## [1] 0.4695216
membership(cfg)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  1  1  1  1  3  3  3  3  1  3  2  2  2  2  2  2  2  2  2  1  1
clp <- cluster_label_prop(inetsym)
modularity(clp)
## [1] 0.3861883
membership(clp)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  1  1  1  1  2  2  2  1  1  2  3  4  1  1  4  4  4  4  4  1  1
cle <- cluster_leading_eigen(inetsym)
modularity(cle)
## [1] 0.464892
membership(cle)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  1  1  1  1  3  3  3  3  1  3  2  2  2  2  2  2  2  2  2  3  3
cl <- cluster_louvain(inetsym)
modularity(cl)
## [1] 0.4903549
membership(cl)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  3  3  3  3  1  1  1  1  1  1  2  2  2  2  2  2  2  2  2  1  1
table(V(inetsym)$role,membership(cw))
##    
##     1 2 3
##   1 2 0 0
##   2 6 3 3
##   3 0 0 1
##   4 1 3 0
##   5 0 2 0
compare(as.numeric(factor(V(inetsym)$role)),cw,method="adjusted.rand")
## [1] 0.02816901
compare(cw,ceb,method="adjusted.rand")
## [1] 1
compare(cw,cs,method="adjusted.rand")
## [1] 1
compare(cw,cfg,method="adjusted.rand")
## [1] 0.7075812
op <- par(mfrow=c(3,2),mar=c(3,0,2,0))
plot(ceb, inetsym,vertex.label=V(inetsym)$name,main="Edge Betweenness")
plot(cfg, inetsym,vertex.label=V(inetsym)$name,main="Fastgreedy")
plot(clp, inetsym,vertex.label=V(inetsym)$name,main="Label Propagation")
plot(cle, inetsym,vertex.label=V(inetsym)$name,main="Leading Eigenvector")
plot(cs, inetsym,vertex.label=V(inetsym)$name,main="Spinglass")
plot(cw, inetsym,vertex.label=V(inetsym)$name,main="Walktrap")

par(op)

Chapter 10

## Trying to generate a similar network using Erdos-Renyi method
no_nodes <- length(V(inetsym))
no_edges <- length(E(inetsym))
generated_network <- erdos.renyi.game(n=no_nodes,no_edges,type='gnm')
op <- par(mfrow=c(1,2))
plot(inetsym,vertex.label=NA,vertex.size=5)
plot(generated_network, vertex.label=NA, vertex.size=5)

par(op)

## Trying to generate a similar network using Small-World Model
avg_degree <- no_edges/no_nodes*2
g1 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.05)
g2 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.15)
g3 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.30)
op <- par(mfrow=c(2,2))
plot(inetsym,vertex.label=NA,vertex.size=5)
plot(g1, vertex.label=NA, vertex.size=5)
plot(g2, vertex.label=NA, vertex.size=5)
plot(g3, vertex.label=NA, vertex.size=5)

par(op)

## Trying to generate a similar network using Scale-Free Model
barabasi_network <- barabasi.game(no_nodes, directed=FALSE)
op <- par(mfrow=c(1,2))
plot(inetsym,vertex.label=NA, vertex.size=5)
plot(barabasi_network,vertex.label=NA, vertex.size=5)

par(op)


## Comparing random models with the empirical network
list_network <- c(generated_network, g2, barabasi_network, inetsym)
comparison_table <- data.frame(
  Name = c("Erdos-Renyi", "Small world", "Scale-free model", "Empiric network"),
  Size = c(length(V(generated_network)), length(V(g2)), length(V(barabasi_network)), length(V(inetsym))),
  Density = c(gden(asNetwork(generated_network)),gden(asNetwork(g2)),gden(asNetwork(barabasi_network)),gden(asNetwork(inetsym))),
  Avg_Degree = c(length(E(generated_network))/length(V(generated_network)),length(E(g2))/length(V(g2)),length(E(barabasi_network))/length(V(barabasi_network)),length(E(inetsym))/length(V(inetsym))),
  Transitivity = c(transitivity(generated_network), transitivity(g2), transitivity(barabasi_network), transitivity(inetsym)),
  Isolates = c(sum(degree(generated_network)==0),sum(degree(g2)==0),sum(degree(barabasi_network)==0),sum(degree(inetsym)==0))
)
comparison_table
##               Name Size   Density Avg_Degree Transitivity Isolates
## 1      Erdos-Renyi   21 0.1714286   1.714286    0.1153846        0
## 2      Small world   21 0.1000000   1.000000    0.0000000        0
## 3 Scale-free model   21 0.0952381   0.952381    0.0000000        0
## 4  Empiric network   21 0.1714286   1.714286    0.2500000        0